home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / WORDS-LIKE < prev   
Encoding:
Text File  |  1992-01-26  |  1.5 KB  |  51 lines
  1.  
  2. \ BTD SEPT 30/86. Changed WORDS-LIKE to check all vocabularies. also
  3. \ added new word ALL-WORDS . which displays all words in all vocabularies.
  4. \ this file can replace the VLIST and WORDS definitions found in VOCS .
  5. \ NOTE: It is also a completely general way of scanning one or all 
  6. \ vocabularies.  
  7. \ COMPILED SIZE: 1010 bytes.
  8.  
  9. \ 00001 PLB 9/16/91 Added FLUSHEMIT so we don't have to wait as long.
  10. \ 00002 mdh 26-jan-92 fixed stack depth when calling ?PAUSE in ID.LIST
  11.  
  12. DECIMAL
  13. ONLY FORTH DEFINITIONS
  14. .NEED .NAME
  15. : .NAME ID. ;
  16. .THEN
  17.  
  18. : STARS  ( N --- )  0 DO ASCII * EMIT LOOP ;
  19.  
  20. : .THIS-VOC     ( VOC-LINK --- ) ?pause CR CR 20 STARS ."  IN VOCABULARY: "
  21.     VLINK>' '>NAME .NAME SPACE 20 STARS CR  ; 
  22.  
  23. BASE @ 
  24. HEX
  25.  
  26. .NEED WORDS
  27. : WORDS   ( --- )   #WORDS OFF  
  28.      [ ' <WORDS> ] LITERAL  IS  WHEN-SCANNED  SCAN-WORDS .#WORDS  ;
  29. .THEN
  30.  
  31. : ALL-WORDS  ( --- )  #WORDS OFF
  32.        [ ' ID.LIST   ] LITERAL  IS  WHEN-SCANNED  
  33.        [ ' .THIS-VOC ] LITERAL  IS  WHEN-VOC-SCANNED 
  34.        SCAN-ALL-VOCS .#WORDS  ;
  35.  
  36. CREATE LIKE-PAD DECIMAL 32 ALLOT HEX UNSMUDGE  \ This could use alloc
  37.  
  38. : <WORDS-LIKE>  ( NFA --- )  ( SUB-STRING AT HERE ) 
  39.       DUP COUNT  1F AND LIKE-PAD COUNT MATCH?    
  40.       IF    DUP>r ( 00002 )  ID.LIST r> flushemit \ 00001
  41.       THEN  DROP ;
  42. BASE ! 
  43.  
  44. : WORDS-LIKE ( --- )  ( <SUB-STRING> --IN-- )  #WORDS OFF 
  45.      BL WORD  LIKE-PAD  $MOVE
  46.     [ ' <WORDS-LIKE>  ] LITERAL IS WHEN-SCANNED 
  47.     [ ' .THIS-VOC     ] LITERAL IS WHEN-VOC-SCANNED 
  48.    SCAN-ALL-VOCS .#WORDS  ;
  49.  
  50. : WL  words-like  ;
  51.